-- card: 36250 from stack: in.5
-- bmap block id: 42871
-- flags: 0000
-- background id: 3858
-- name: INITList
----- HyperTalk script -----
on CloseCard
  put empty into cd fld "INIT list"
  set the scroll of cd fld "INIT list" to 0
  pass CloseCard
end CloseCard

on HideObjects
  hide cd fld "INIT list"
  hide cd btn "“Detailed”"
  hide cd btn "All files reported"
end HideObjects

on ShowObjects
  show cd fld "INIT list"
  show cd btn "“Detailed”"
  show cd btn "All files reported"
end ShowObjects


-- part 1 (field)
-- low flags: 00
-- high flags: 0007
-- rect: left=19 top=117 right=288 bottom=236
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: INIT list


-- part 2 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=22 top=292 right=326 bottom=125
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: �Detailed�
----- HyperTalk script -----
on mouseUp
  global errGlobal
  set cursor to watch
  put INITList("Detailed", "noDialog:errGlobal") into INITInfo
  if errGlobal ≠ empty then
    answer "Error: “" & errGlobal & "”"
    put empty into errGlobal
  else
    put INITInfo into cd fld "init list"
  end if
end mouseUp




-- part 4 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=130 top=292 right=326 bottom=233
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: All Files Reported
----- HyperTalk script -----
on mouseUp
  global errGlobal
  set cursor to watch
  put INITList("", "noDialog:errGlobal") into INITInfo
  if errGlobal ≠ empty then
    answer "Error: “" & errGlobal & "”"
    put empty into errGlobal
  else
    put INITInfo into cd fld "init list"
  end if
end mouseUp




-- part contents for background part 38
----- text -----
26/50

-- part contents for background part 20
----- text -----
     An XFCN which scans the System Folder of the system startup volume for files of type 'INIT' and 'RDEV' and 'cdev' and returns the names of all files in a carraige return delimited list.  All control characters in file names (ASCII value less than 32) are represented by period ('.'). 

     If nothing is passed as the first parameter, all files of these types will be listed.  If the literal string “DETAILED” is passed as the first parameter, each file will be opened to see if it contains a resource of type INIT .  In this case, the file name will not be returned unless an INIT resource is found.  Opening all files will take longer. On my system “DETAILED” takes 30 ticks to report 19 files, compared with 10 ticks to list 29 files (Mac IIx).

     Calling syntax : INITList(<“Detailed”, <“noDialog:”errGlobal>)
  DETAILED: open all files to make sure that they contain a resource of type INIT.

NOTE: The list of INITs reported by this XFCN may not exactly represent the list of INITs actually run at startup time on systems which use one of the INITs which change the order of INIT loading without changing file type ie. “INITPicker”, “INITHound”, etc.   In such a case the list may contain the names of more files than actually ran at startup.


-- part contents for background part 42
----- text -----
unit INITFinder;
{}
{ At startup the system scans the System Folder of the system}
{ startup volume for files of type 'INIT' and 'RDEV'.  When it finds }
{ it opens the file and calls all resources of type 'INIT'.  We mimic }
{ this process, but just return the names of all files. }
{}
{  brought to you by:  Anup Murarka      Eric Carlson    }
{            ALINK:  SKEPTIC      ALINK:  cyNic  }
{                  CIS:  76004,3356    }
{}
{        We are part of the Support Tools Development Group,  }
{        Apple Computer, Inc.   }
{}
{        please DO NOT contack Mac DTS for support of this code!  }
{}
{        please DO contact the authors for support of this code!  }
{}
{        Send comments, bug reports, requests to any of the above  }
{        E-mail addresses or to:}
{}
{              (one of us)          }
{              Apple Computer, Inc.     }
{              900 E. Hamilton, Ave.    }
{              Campbell, CA   95008    }
{              M/S 72-L          }
{}
{  Copyright:  © 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
{}
{ written by Eric Carlson                    }
{ AppleLink:  cyNic                        }
{ modification history                      }
{       Date        Initials                  Comments              }
{       ----        ------  ------------------------------------------------------}
{    8/16/89      ec       first written                            }
{    2/18/90      ec      modified to build handle rather than str255 with names, avoid}
{                    overflow for large init lists  }
{}

interface
  uses
    HyperXCMD;

  procedure main (paramPtr: XCmdPtr);

implementation

  procedure reportToUser (paramPtr: XCmdPtr;
                  msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
    var
      tempStr: str255;
  begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
    ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
    UprString(tempStr, true);
    if pos('NODIALOG', tempStr) = 0 then
  { no special error handling specified, throw up a dialog and return the error message }
      begin
        SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
        paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
      end
    else if (pos(':', tempStr) > 0) then
  { requested global AND noDialog so we fill in the global and return empty }
      begin
        tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                            { get the name of the HC global  to fill }
        SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                            { and fill it }
        paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
      end
    else
  { requested noDialog only so we return the error condition as the result }
      paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  end;  { procedure }

  function AskedForHelp (paramPtr: XCmdPtr;
                  syntaxMsg: Str255;
                  copyrightMsg: Str255): boolean;
{  check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
    var
      firstStr: str255;
  begin
    askedForHelp := false;
    if paramPtr^.paramCount = 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
          { what is the first param? }
        if firstStr = '?' then
          begin
            reportToUser(paramPtr, syntaxMsg);
            askedForHelp := true
          end  { asked for help }
        else if firstStr = '!' then
          begin
            reportToUser(paramPtr, copyRightMsg);
            askedForHelp := true
          end;  { asked for copyright info }
      end;  { one parameter passed }
  end;  { function }

  function NumberToString (paramPtr: XCmdPtr;
                  num: LONGINT): Str255;
{ use the toolbox call rather than HC's }
    var
      tempStr: str255;
  begin
    NumToString(num, tempStr);
    NumberToString := tempStr;
  end;

  procedure reportResError (var paramPtr: XCmdPtr;
                  errorNum: integer);
    var
      errMsg, tempName: str255;
  begin
    case errorNum of          { what caused the problem? }
      -0: 
        errMsg := 'no error.';
      25: 
        errMsg := 'out of memory.';
      -36: 
        errMsg := 'I/O Error.';
      -37: 
        errMsg := 'bad file name or volume name.';
      -38: 
        errMsg := 'file not open.';
      -39: 
        errMsg := 'that file has no resource fork.';
      -42: 
        errMsg := 'too many files open.';
      -43: 
        errMsg := 'file not found.';
      -45, -54, -61: 
        errMsg := 'file locked.';
      -47, -49: 
        errMsg := 'file is busy.';
      -53: 
        errMsg := 'that volume is not on line.';
      -108: 
        errMsg := 'not enough room in heap zone.';
      -120: 
        errMsg := 'directory not found.';
      -121: 
        errMsg := 'too many working directories open.';
      -127: 
        errMsg := 'internal file system error.';
      -192: 
        errMsg := 'resource not found.';
      -193: 
        errMsg := 'file not found.';
      otherwise
        errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
    end;    { case }

    errMsg := concat('Sorry, ', errMsg);
    reportToUser(paramPtr, errMsg);
    { return the error message }
  end;    { function }

  function BitTest (AddressToCheck: ptr;
                  TotalBits: integer;
                  BitToTest: longint): boolean;
  { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
  { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
  begin
    BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
  end;

  function AppendString (hndl: Handle;
                  newStr: Str255): OSErr;
{}
{ stick the string onto the back of the handle }
{}
  begin
    AppendString := PtrAndHand(Ptr(ORD4(@newStr) + 1), hndl, LENGTH(newStr));
  end;

  function StripControls (replacementChar: char;
                  theStr: Str255): Str255;
{ replace all control characters in the passed string }
    var
      charPos: integer;
  begin
    for charPos := 1 to length(theStr) do
      if ord(theStr[charPos]) < 32 then      { char < ascii 32? }
        theStr[charPos] := replacementChar;    { yes, replace it }
    StripControls := theStr;
  end;

  procedure INITFinder (paramPtr: XCmdPtr);
    label
      10;
    type
      HFSBlock = record
          case integer of
            1: (
                HBlock: HParamBlockRec
            );
            2: (
                WDBlock: WDPBRec
            );
            3: (
                InfoBlock: CInfoPBRec
            );
        end;
    var
      ourHFSBlock: HFSBlock;
      fName, detailStr, copyRtStr, syntaxStr: Str255;
      sysFolder: longint;
      INITCount, systemVRefNum: integer;
      fileCount, index, errorCode, theRes: integer;
      sysRec: SysEnvRec;
      nameList: handle;
      tempLong: longint;

  begin
    syntaxStr := 'INITList(<“Detailed”>, <“noDialog:”errorGlobal>)';
    copyRtStr := '© 1989 Apple Computer, Inc., v.1.1, by Eric Carlson.';

    if (askedForHelp(paramPtr, syntaxStr, copyRtStr)) then
      exit(INITFinder);

{ find out if we should open every file to explicitly look for INITs }
    detailStr := '';
    ZeroToPas(paramPtr, paramPtr^.params[1]^, detailStr);
    UprString(detailStr, true);

{ Get the vrefnum of the directory containing the open System file. }
{ We will use this in our OpenRFPerm call since we don't have (or need) }
{ the full path name to the system folder. }
    errorCode := SysEnvirons(2, sysRec);
    if errorCode <> noErr then
      begin
        reportResError(paramPtr, errorCode);
        exit(INITFinder);
      end;
    systemVRefNum := sysRec.sysVRefNum;

    with ourHFSBlock.HBlock do
      begin
        ioCompletion := nil;
        ioNamePtr := nil;
        ioVRefNum := systemVRefNum;
        ioVolIndex := 0;
      end;

    errorCode := PBHGetVInfo(@ourHFSBlock, false);
    if errorCode <> noErr then
      begin
        reportResError(paramPtr, errorCode);
        exit(INITFinder);
      end;

    SysFolder := ourHFSBlock.HBlock.ioVFndrInfo[1];

    with ourHFSBlock.WDBlock do
      begin
        ioWDDirID := SysFolder;
        ioCompletion := nil;
        ioNamePtr := nil;
        ioVRefNum := systemVRefNum;
      end;

    with ourHFSBlock.InfoBlock do
      begin
        ioCompletion := nil;
        ioNamePtr := nil;
        ioVRefNum := systemVRefNum;
        ioFDirIndex := -1;
        ioDrDirID := SysFolder;
      end;

    errorCode := PBGetCatInfo(@ourHFSBlock, false);
    if errorCode <> noErr then
      begin
        reportResError(paramPtr, errorCode);
        exit(INITFinder);
      end;

    nameList := NewHandle(0);
    errorCode := MemError;
    if errorCode <> noErr then
      begin
        reportResError(paramPtr, errorCode);
        exit(INITFinder);
      end;

{  Use PBGetCatInfo to determine the number of files and folders}
{     in the System folder. }
    FileCount := ourHFSBlock.InfoBlock.ioDrNmFls;
    MoveHHI(nameList);                    { lock down the list }

{  Now index through the System folder, calling PBGetCatInfo for   }
{ each object within it.  Check the attributes to see if it is a folder.  }
{ If it is not, then see if the file is of type INIT, cdev, or RDEV.     }
{ If it is one of these types and we are supposed to be making a     }
{ list,  open the resource fork and look for a resource of type INIT.    }
{ If one is found,  report the name of the file}
    for index := 1 to FileCount do
      begin
        fName := '';
        with ourHFSBlock.InfoBlock do
          begin
            ioCompletion := nil;
            ioNamePtr := @fName;
            ioVRefNum := systemVRefNum;
            ioFDirIndex := index;
            ioDirID := SysFolder;
          end;

        errorCode := PBGetCatInfo(@ourHFSBlock, false);
        if errorCode <> noErr then
          begin
            reportResError(paramPtr, errorCode);
            goto 10;
          end;

        if not BitTest(@ourHFSBlock.InfoBlock.ioFlAttrib, 8, 4) then  { not a directory }
          if (ourHFSBlock.InfoBlock.ioFlFndrInfo.fdType = 'INIT') or (ourHFSBlock.InfoBlock.ioFlFndrInfo.fdType = 'cdev') or (ourHFSBlock.InfoBlock.ioFlFndrInfo.fdType = 'RDEV') then
            begin
              if detailStr = 'DETAILED' then        { open every file and look for 'INIT' resources }
                begin
                  TheRes := OpenRFPerm(fName, systemVRefNum, fsRdPerm);
                  if ResError <> noErr then
                    begin
                      CloseResFile(TheRes);
                      goto 10;
                    end;
                  INITCount := count1Resources('INIT');
                  if INITCount = 0 then
                    fName := '';
                  CloseResFile(TheRes);
                end;    { asked to open all files }

              if fName <> '' then
                begin
                  fName := StripControls('.', fName);        { replace any control chars from the file name }
                  fName := concat(fName, chr(13));          { add a return and }
                  errorCode := AppendString(nameList, fName);  { add the name to the list }
                  if errorCode <> noErr then
                    begin
                      reportResError(paramPtr, errorCode);
                      if nameList <> nil then
                        disposHandle(nameList);
                      exit(INITFinder);
                    end;    { no error }
                end;    { we have a name to report }
            end;    { file of type cdev, INIT, or RDEV }
10:
      end;    { looping through files }
    if nameList <> nil then
      begin
        SetHandleSize(nameList, GetHandleSize(nameList) - 1);  { drop the trailing comma }
        errorCode := AppendString(nameList, chr(0));        { Terminate with 0 byte  }
        if errorCode <> noErr then
          reportResError(paramPtr, errorCode);
      end;
    paramPtr^.returnValue := nameList;
  end;

  procedure main (paramPtr: XCmdPtr);
  begin
    INITFinder(paramPtr);
  end;
end.